home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
tvdmx.exe
/
COLLECTR.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-07-16
|
9KB
|
311 lines
{■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
{ }
{ COLLECTR --Collection Data Editing Demo }
{ tvDMX --data editing project }
{ }
{ Copyright (c) 1992 Randolph Beck }
{ P.O. Box 56-0487 }
{ Orlando, FL 32856 }
{ CIS: 72361,753 }
{ }
{■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
Program COLLECTR;
(* This program demonstrates how to use unit tvDMXCOL.PAS with a collection
of records and a collection of objects. tvDMXCOL uses TDmxCollector (a
tvDMX descendant object) to edit data in collections.
Although TDmxCollector can be derived to work with sorted collections,
this would require some changes to the EvaluateRecord() method.
Even so, this perpetual sorting could disturb the user, so it might
still be best to transfer the data to a non-sorting collection and then
sort again afterward.
TDmxCollectorWin is a TDmxWindow derivative that uses TDmxCollector.
Both of the sample windows in this program are of the same structure and
appearance, but this was only to make my work easier. It should be easy
to insert TDmxCollectorWin-windows into your programs with your data.
Just make sure that your DMX template matches the data.
Function fldObjectVMT (Obj : PObject) : string;
...generates a template prefix for an object's virtual method table.
This is declared in unit tvDMXCOL. It should be used with collections
of TObject derivatives so that tvDMX can create VMT's when new records
are entered. Object Obj is disposed after its VMT code is known.
The template prefix is actually a pair of hidden fields with default
values as that of the VMT ID.
Procedure ObjWindow() uses this function.
*)
{$V-,X+,B-,R- }
uses
Objects, Drivers, Memory, Views, Menus, App, MsgBox,
RSet, DmxGizma, tvDMX, StdDMX, tvDMXCOL, tvDMXREP, tvGizma;
const
cmRecWin = 101;
cmObjWin = 102;
cmReport = 103;
{ This is the label and template for record TMyRecord. }
_RecLabels = ' String Field String Field 2 +Real Real Word Seg : Ofs ';
RecTemplate = ' ssssssssssssssssssss| ssssssssssssssssssss║RRRRRRR.RRR |($rr,rrr.rr)|WWWWW ║ HHHH:HHHH ';
RecLabels : string [length (_RecLabels)] = _RecLabels;
{ This is the label and template for object TMyObject. }
_ObjLabels = ' String Field String Field 2 +Real Real Word Seg : Ofs ';
ObjTemplate = ' ssssssssssssssssssss| ssssssssssssssssssss║RRRRRRR.RRR |($rr,rrr.rr)|WWWWW ║ HHHH:HHHH ';
ObjLabels : string [length (_ObjLabels)] = _ObjLabels;
{ The codes to provide for a VMT are concatenated in TApp.ObjWindow. }
type
PRecCollection = ^TRecCollection;
TRecCollection = OBJECT (TCollection)
procedure FreeItem (Item : pointer); VIRTUAL;
end;
PMyRecord = ^TMyRecord;
TMyRecord = RECORD
S1 : string [20];
S2 : string [20];
R1,R2 : real;
W : word;
P : pointer;
end;
PMyObject = ^TMyObject;
TMyObject = OBJECT (TObject)
S1 : string [20];
S2 : string [20];
R1,R2 : real;
W : word;
P : pointer;
constructor Init (AS1,AS2 :string; AR1,AR2 :real; AW :word; AP :pointer);
end;
TApp = OBJECT (TAppA)
procedure HandleEvent (var Event : TEvent); VIRTUAL;
procedure Idle; VIRTUAL;
procedure InitMenuBar; VIRTUAL;
procedure RecWindow;
procedure ObjWindow;
end;
var
RecCollection : PRecCollection;
ObjCollection : PCollection;
{ ══ TRecCollection ════════════════════════════════════════════════════ }
procedure TRecCollection.FreeItem (Item : pointer);
begin
If (Item <> nil) then Dispose (PMyRecord (Item));
end;
{ ══ TMyObject ═════════════════════════════════════════════════════════ }
constructor TMyObject.Init (AS1,AS2 :string; AR1,AR2 :real; AW :word; AP :pointer);
begin
TObject.Init;
S1 := AS1;
S2 := AS2;
R1 := AR1;
R2 := AR2;
W := AW;
P := AP;
end;
{ ══ TApp ══════════════════════════════════════════════════════════════ }
procedure TApp.HandleEvent (var Event : TEvent);
procedure DoReport;
begin
DmxReportBox ('Working', 'Processing report...'^M^M^C'COLLECTR.OUT',
New (PDmxReportFile, Init (Message (DeskTop, evCommand, cmDMX_RollCall, @Self),
'|', TRUE, 50,78, 'COLLECTR.OUT')));
end;
begin
TAppA.HandleEvent (Event);
If Event.What = evCommand then
begin
Case Event.Command of
cmRecWin: RecWindow;
cmObjWin: ObjWindow;
cmReport: DoReport;
else Exit;
end;
ClearEvent (Event);
end;
end;
procedure TApp.Idle;
begin
TAppA.Idle;
If (Message (DeskTop, evCommand, cmDMX_RollCall, @Self) <> nil) then
EnableCommands ([cmReport])
else
DisableCommands ([cmReport]);
end;
procedure TApp.InitMenuBar;
var R: TRect;
begin
GetExtent (R);
R.B.Y := R.A.Y + 1;
MenuBar := New (PMenuBar, Init (R, NewMenu (
NewSubMenu ('~C~ollector', hcNoContext, NewMenu (
NewItem ('~R~ecords', 'F3', kbF3, cmRecWin, hcNoContext,
NewItem ('~O~bjects', 'F4', kbF4, cmObjWin, hcNoContext,
NewItem ('R~e~port', 'F9', kbF9, cmReport, hcNoContext,
NewLine (
NewSoundItem (hcNoContext, { these are methods of TAppA }
NewVideoItem (hcNoContext, { this item appears only on hi-res systems }
NewLine (
NewItem ('e~X~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
nil))))))))),
NewSubMenu ('~W~indow', hcNoContext, NewMenu (
NewItem ('~S~ize/Move', 'Ctrl-F5', kbCtrlF5, cmResize, hcNoContext,
NewItem ('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
NewItem ('~T~ile', '', kbNoKey, cmTile, hcNoContext,
NewItem ('C~a~scade', '', kbNoKey, cmCascade, hcNoContext,
NewItem ('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
NewItem ('~P~revious', 'Shift-F6', kbShiftF6, cmPrev, hcNoContext,
NewItem ('~C~lose', 'Alt-F3', kbAltF3, cmClose, hcNoContext,
NewLine (
NewItem ('~U~ser screen', 'Alt-F5', kbAltF5, cmUserScreen, hcNoContext,
nil)))))))))),
nil)))
));
end;
procedure TApp.RecWindow;
var R : TRect;
begin
AssignWinRect (R, 0,0);
DeskTop^.Insert (ValidView (New (PDmxCollectorWin, Init (R,
'Record Editor',
NextWindowNumber,
RecTemplate,
RecCollection,
0, { maximum collection size (0=no limit; -1=no expansions) }
RecLabels, 11)
)));
end;
procedure TApp.ObjWindow;
var R : TRect;
begin
AssignWinRect (R, 0,0);
DeskTop^.Insert (ValidView (New (PDmxCollectorWin, Init (R,
'Object Editor',
NextWindowNumber,
fldObjectVMT (New (PMyObject,Init ('','',0.,0.,0,nil)))
+ ObjTemplate,
ObjCollection,
0, { maximum collection size (0=no limit; -1=no expansions) }
ObjLabels, 11)
)));
end;
{ ══════════════════════════════════════════════════════════════════════ }
procedure InitializeData;
{ creates test data }
function NewRec (AS1,AS2 :string; AR1,AR2 :real; AW :word; AP :pointer) : PMyRecord;
var PR : PMyRecord;
begin
New (PR);
With PR^ do
begin
S1 := AS1;
S2 := AS2;
R1 := AR1;
R2 := AR2;
W := AW;
P := AP;
end;
NewRec := PR;
end;
begin
RecCollection^.Insert (NewRec ('Abigail Adams', 'Massachusetts',1,1, 1, pointer (MemL [0:0])));
RecCollection^.Insert (NewRec ('Betty Boop', 'ToonTown', 2,2, 2, pointer (MemL [0:4])));
RecCollection^.Insert (NewRec ('Charlie Chaplin','IBM Archives', 3,3, 3, pointer (MemL [0:8])));
RecCollection^.Insert (NewRec ('Doris Day', 'Hollywood', 4,4, 4, pointer (MemL [0:12])));
RecCollection^.Insert (NewRec ('Elbert Eagleton','Elm Street', 5,5, 5, pointer (MemL [0:16])));
ObjCollection^.In